Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -233,10 +233,13 @@ (let ((sectdat (hash-table-ref/default cfgdat section '()))) (if (null? sectdat) '() (map car sectdat)))) +(define (configf:get-section cfdat section) + (hash-table-ref/default cfgdat section '())) + (define (setup) (let* ((configf (find-config)) (config (if configf (read-config configf #f #t) #f))) (if config (setenv "RUN_AREA_HOME" (pathname-directory configf))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -611,13 +611,12 @@ ;;====================================================================== ;; Misc. test related queries ;;====================================================================== -(define (db:test-get-paths-matching db keynames target) - (let* ((res '()) - (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%")) +(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '())) + (let* ((itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%")) (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%")) (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%")) (runname (if (args:get-arg ":runname") (args:get-arg ":runname") "%")) (keystr (string-intersperse @@ -634,11 +633,37 @@ (sqlite3:for-each-row (lambda (p) (set! res (cons p res))) db qrystr) - res)) + (if fnamepatt + (apply append + (map (lambda (p) + (glob (conc p "/" fnamepatt))) + res)) + res))) + +;; look through tests from matching runs for a file +(define (db:test-get-first-path-matching db keynames target fname) + ;; [refpaths] is the section where references to other megatest databases are stored + (let ((mt-paths (configf:get-section "refpaths")) + (res (db:test-get-paths-matching db keynames target fname))) + (let loop ((pathdat (if (null? paths) #f (car mt-paths))) + (tal (if (null? paths) '()(cdr mt-paths)))) + (if (not (null? res)) + (car res) ;; return first found + (if path + (let* ((db (open-db path: (cadr pathdat))) + (newres (db:test-get-paths-matching db keynames target fname))) + (debug:print 4 "INFO: Trying " (car pathdat) " at " (cadr pathdat)) + (sqlite3:finalize! db) + (if (not (null? newres)) + (car newres) + (if (null? tal) + #f + (loop (car tal)(cdr tal)))))))))) + (define (db:test-get-test-records-matching db keynames target) (let* ((res '()) (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%")) (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -73,19 +73,18 @@ :variable : set the variable name (optional) :value : value measured (required) :expected : value expected (required) :tol : |value-expect| <= tol (required, can be <, >, >=, <= or number) :units : name of the units for value, expected_value etc. (optional) - -load-test-data : read test specific data for storage in the test_data table from standard in. Each line is comma delimited with four fields category,variable,value,comment Queries -list-runs patt : list runs matching pattern \"patt\", % is the wildcard -showkeys : show the keys used in this megatest setup - -test-paths targpatt : get the most recent test path(s) matching targpatt e.g. %/%... + -test-path targpatt : get the most recent test path(s) matching targpatt e.g. %/%... returns list sorted by age ascending, see examples below Misc -rebuild-db : bring the database schema up to date -update-meta : update the tests metadata for all tests @@ -101,16 +100,14 @@ -pathmod path : insert path, i.e. path/runame/itempath/logfile.html will clear the field if no rundir/testname/itempath/logfile if it contains forward slashes the path will be converted to windows style -Helpers (these only apply in test run mode) - Examples -# Get test paths -megatest -test-paths -target ubuntu/n%/no% :runname w49% -testpatt test_mt% +# Get test path, the '.' is required, could use '*' or a specific path/file +megatest -test-path . -target ubuntu/n%/no% :runname w49% -testpatt test_mt% Called as " (string-intersperse (argv) " "))) ;; -gui : start a gui interface ;; -config fname : override the runconfig file with fname @@ -172,10 +169,11 @@ "-repl" "-lock" "-unlock" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first + "-test-path" ;; -test-paths is deprecated "-runall" ;; run all tests "-remove-runs" "-usequeue" "-rebuild-db" @@ -447,11 +445,11 @@ ;;====================================================================== ;; Get paths to tests ;;====================================================================== ;; Get test paths matching target, runname, testpatt, and itempatt -(if (args:get-arg "-test-paths") +(if (or (args:get-arg "-test-path")(args:get-arg "-test-paths")) ;; if we are in a test use the MT_CMDINFO data (if (getenv "MT_CMDINFO") (let* ((startingdir (current-directory)) (cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO"))))) (testpath (assoc/default 'testpath cmdinfo)) @@ -469,11 +467,11 @@ (begin (debug:print 0 "ERROR: -target is required.") (exit 1))) (if (not (setup-for-run)) (begin - (debug:print 0 "Failed to setup, giving up on -test-paths, exiting") + (debug:print 0 "Failed to setup, giving up on -test-path, exiting") (exit 1))) (set! db (open-db)) (if (not (args:get-arg "-server")) (server:client-setup db)) (let* ((itempatt (args:get-arg "-itempatt")) @@ -484,12 +482,12 @@ (for-each (lambda (path) (print path)) paths))) ;; else do a general-run-call (general-run-call - "-test-paths" - "Get paths to tests" + "-test-path" + "Get paths to test" (lambda (db target runname keys keynames keyvallst) (let* ((itempatt (args:get-arg "-itempatt")) (paths (rdb:test-get-paths-matching db keynames target))) (for-each (lambda (path) (print path)) Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -1,9 +1,14 @@ [fields] sysname TEXT fsname TEXT datapath TEXT + +# refareas can be searched to find previous runs +# the path points to where megatest.db exists +[refareas] +area1 /tmp/oldarea/megatest [setup] # exectutable /path/to/megatest max_concurrent_jobs 200 linktree /tmp/mt_links