@@ -97,10 +97,11 @@ -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 --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) -setlog logfname : set the path/filename to the final log relative to the test @@ -138,10 +139,11 @@ -section sectionName -var varName : for config and runconfig lookup value for sectionName varName -since N : get list of runs changed since time N (Unix seconds) -fields fieldspec : fields to include in json dump; runs:id,runame+tests:testname+steps -sort fieldname : in -list-runs sort tests by this field + -testdata-csv [categorypatt/]varpatt : dump testdata for given category Misc -start-dir path : switch to this directory before running megatest -contour cname : add a level of hierarcy to the linktree and run paths -rebuild-db : bring the database schema up to date @@ -226,10 +228,11 @@ ":state" "-state" ":status" "-status" "-list-runs" + "-testdata-csv" "-testpatt" "--modepatt" "-tagexpr" "-itempatt" "-setlog" @@ -401,10 +404,11 @@ ;;(if (not (args:get-arg "-server")) ;; (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog (let* ((no-watchdog-args '("-list-runs" + "-testdata-csv" "-list-servers" "-server" "-list-disks" "-list-targets" "-show-runconfig" @@ -1047,10 +1051,114 @@ (if indx (if (>= indx (vector-length datavec)) #f ;; index too high, should raise an error I suppose (vector-ref datavec indx)) #f))) + + + + + +(when (args:get-arg "-testdata-csv") + (if (launch:setup) + (let* ((keys (rmt:get-keys)) ;; (db:get-keys dbstruct)) + (runpatt (or (args:get-arg "-runname") "%")) + (testpatt (common:args-get-testpatt #f)) + (datapatt (args:get-arg "-testdata-csv")) + (match-data (string-match "^([^/]+)/(.*)" (args:get-arg "-testdata-csv"))) + (categorypatt (if match-data (list-ref match-data 1) "%")) + (setvarpatt (if match-data + (list-ref match-data 2) + (args:get-arg "-testdata-csv"))) + (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") + (common:args-get-target) #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0)) + (header (db:get-header runsdat)) + (access-mode (db:get-access-mode)) + (testpatt (common:args-get-testpatt #f)) + (fields-spec (if (args:get-arg "-fields") + (extract-fields-constraints (args:get-arg "-fields")) + (list (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count"))) + (cons "tests" db:test-record-fields) ;; "id" "testname" "test_path") + (list "steps" "id" "stepname")))) + (tests-spec (let ((t (alist-ref "tests" fields-spec equal?))) + (if (and t (null? t)) ;; all fields + db:test-record-fields + t))) + (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) + (test-field-index (make-hash-table)) + (runs (db:get-rows runsdat)) + ) + (if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec + (let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec))) + (if (null? invalid-tests-spec) + ;; generate the lookup map test-field-name => index-number + (let loop ((hed (car adj-tests-spec)) + (tal (cdr adj-tests-spec)) + (idx 0)) + (hash-table-set! test-field-index hed idx) + (if (not (null? tal))(loop (car tal)(cdr tal)(+ idx 1)))) + (begin + (debug:print-error 0 *default-log-port* "Invalid test fields specified: " (string-intersperse invalid-tests-spec ", ")) + (exit))))) + (let* ((table-header (string-split "target,run,test,itempath,category,var,value,comment" ",")) + (table-rows + (apply append (map + (lambda (run) + (let* ((target (string-intersperse (map (lambda (x) + (db:get-value-by-header run header x)) + keys) "/")) + (statuses (string-split (or (args:get-arg "-status") "") ",")) + (run-id (db:get-value-by-header run header "id")) + (runname (db:get-value-by-header run header "runname")) + (states (string-split (or (args:get-arg "-state") "") ",")) + (tests (if tests-spec + (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run run-id testpatt states statuses #f #f #f 'testname 'asc ;; (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc + ;; use qryvals if test-spec provided + (if tests-spec + (string-intersperse adj-tests-spec ",") + ;; db:test-record-fields + #f) + #f + 'normal) + '()))) + (apply append + (map + (lambda (test) + (let* ( + (test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test)) + (testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test)) + (itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test)) + (fullname (conc testname + (if (equal? itempath "") + "" + (conc "/" itempath )))) + (testdat-raw (map vector->list (rmt:read-test-data* run-id test-id categorypatt setvarpatt))) + (testdat (filter + (lambda (x) + (not (equal? "logpro" + (list-ref x 10)))) + testdat-raw))) + (map + (lambda (item) + (receive (id test_id category + variable value expected + tol units comment status type) + (apply values item) + (list target runname testname itempath category variable value comment))) + testdat))) + tests)))) + runs)))) + (print (string-join table-header ",")) + (for-each (lambda(table-row) + (print (string-join (map ->string table-row) ","))) + + + table-rows)))) + (set! *didsomething* #t) + (set! *time-to-exit* #t)) + + ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; ;; IDEA: megatest list -runname blah% ... ;;