Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1694,10 +1694,26 @@ db qrystr ))) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) + +(define (db:get-changed-run-ids since-time) + (let* ((dbdir (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir")) + (alldbs (glob (conc dbdir "/[0-9]*.db"))) + (changed (filter (lambda (dbfile) + (> (file-modification-time dbfile) since-time)) + alldbs))) + (delete-duplicates + (map (lambda (dbfile) + (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile))) + (if res + (string->number (cadr res)) + (begin + (debug:print 2 "WARNING: Failed to process " dbfile " for run-id") + 0)))) + changed)))) ;; db:get-runs-by-patt ;; get runs by list of criteria ;; register a test run with the db ;; @@ -1814,11 +1830,11 @@ (db:delay-if-busy dbdat) (sqlite3:for-each-row (lambda (run-id runname) (set! runs-info (cons (list run-id runname) runs-info))) db - "SELECT id,runname FROM runs WHERE state != 'deleted';") + "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats ;; for each run get stats data (for-each (lambda (run-info) ;; get the net state/status counts for this run (let* ((run-id (car run-info)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -127,11 +127,11 @@ -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) -section sectionName -var varName : for config and runconfig lookup value for sectionName varName - -changed-runs-since N : get list of runs changed since time N (Unix seconds) + -since N : get list of runs changed since time N (Unix seconds) Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db @@ -244,11 +244,11 @@ "-ping" "-refdb2dat" "-o" "-log" "-archive" - "-changed-runs-since" + "-since" ) (list "-h" "-help" "--help" "-version" "-force" "-xterm" @@ -901,12 +901,25 @@ "%")) (keys (db:get-keys dbstruct)) ;; (runsdat (db:get-runs dbstruct runpatt #f #f '())) (runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) #f #f)) - (runs (db:get-rows runsdat)) + (runstmp (db:get-rows runsdat)) (header (db:get-header runsdat)) + (runs (if (and (not (null? runstmp)) + (args:get-arg "-since")) + (let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since"))))) + (let loop ((hed (car runstmp)) + (tal (cdr runstmp)) + (res '())) + (let ((new-res (if (member (db:get-value-by-header hed header "id") changed-ids) + (cons hed res) + res))) + (if (null? tal) + (reverse new-res) + (loop (car tal)(cdr tal) new-res))))) + runstmp)) (db-targets (args:get-arg "-list-db-targets")) (seen (make-hash-table)) (dmode (let ((d (args:get-arg "-dumpmode"))) (if d (string->symbol d) #f))) (data (make-hash-table))) @@ -937,11 +950,11 @@ " run-id: " run-id ", number tests: " (length tests)))) (for-each (lambda (test) (handle-exceptions exn - (debug:print 0 "ERROR: Bad data in test record? " test) + (debug:print 4 "ERROR: Bad data in test record? " test) (let ((test-id (db:test-get-id test)) (fullname (conc (db:test-get-testname test) (if (equal? (db:test-get-item-path test) "") "" (conc "(" (db:test-get-item-path test) ")")))) @@ -989,30 +1002,19 @@ tests))))) runs) (if (eq? dmode 'json)(json-write data)) (set! *didsomething* #t)))) -(if (and (args:get-arg "-changed-runs-since") - (launch:setup-for-run)) - (let* ((since-time (string->number (args:get-arg "-changed-runs-since"))) - (dbdir (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir")) - (alldbs (glob (conc dbdir "/[0-9]*.db"))) - (changed (filter (lambda (dbfile) - (> (file-modification-time dbfile) since-time)) - alldbs)) - (run-ids (delete-duplicates - (map (lambda (dbfile) - (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile))) - (if res - (string->number (cadr res)) - (begin - (debug:print 2 "ERROR: Failed to process " dbfile " for run-id") - 0)))) - changed)))) - ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) - (print (sort run-ids <)) - (set! *didsomething* #t))) +;; Don't think I need this. Incorporated into -list-runs instead +;; +;; (if (and (args:get-arg "-since") +;; (launch:setup-for-run)) +;; (let* ((since-time (string->number (args:get-arg "-since"))) +;; (run-ids (db:get-changed-run-ids since-time))) +;; ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) +;; (print (sort run-ids <)) +;; (set! *didsomething* #t))) ;;====================================================================== ;; full run ;;======================================================================